SetUTMparametersSystem Subroutine

private subroutine SetUTMparametersSystem(system, zone, hemisphere, override)

Set parameters for Universal Transverse Mercator reference system

Arguments

Type IntentOptional Attributes Name
type(CRS), intent(inout) :: system
integer(kind=short), intent(in) :: zone
integer(kind=short), intent(in) :: hemisphere
integer(kind=short), intent(in), optional :: override

Source Code

SUBROUTINE SetUTMparametersSystem &
!
(system, zone, hemisphere, override)

IMPLICIT NONE

!Arguments with intent (in):
INTEGER (KIND = short), INTENT (IN) :: zone
INTEGER (KIND = short), INTENT (IN) :: hemisphere
INTEGER (KIND = short), OPTIONAL, INTENT (IN) :: override
! Arguments with intent (inout):
TYPE (CRS), INTENT (INOUT) :: system

!------------end of declaration------------------------------------------------

!set UTM parameters value
system % param (UTM_lat0)  = 0.
IF ( zone >= 31 ) THEN
  system % param (UTM_centM) = (6 * Zone - 183) * degToRad  
ELSE
  system % param (UTM_centM) = (6 * Zone + 177) * degToRad
END IF
system % param (UTM_zone)       = zone 
system % param (UTM_hemisphere) = hemisphere
system % param (UTM_false_easting) = 500000.
IF ( hemisphere == NORTH ) THEN
  system % param (UTM_false_northing) = 0.
ELSE
  system % param (UTM_false_northing) = 10000000.
END IF
system % param (UTM_scale_factor) = 0.9996
IF (PRESENT (override) ) THEN
  system % param (UTM_override) = override
ELSE
  !set default to 0 = override off
  system % param (UTM_override) = 0. 
END IF

!Set UTM parameters description
system % description (UTM_lat0) = 'latitude_of_projection_origin'
system % description (UTM_centM) = 'central_meridian' ! 'longitude_of_projection_origin'
system % description (UTM_zone) = 'zone'
IF ( hemisphere == NORTH ) THEN
  system % description (UTM_hemisphere) = 'North'
ELSE
  system % description (UTM_hemisphere) = 'South'
END IF
system % description (UTM_false_easting) = 'false_easting'
system % description (UTM_false_northing) = 'false_northing'
system % description (UTM_scale_factor) = 'scale_factor'

END SUBROUTINE SetUTMparametersSystem